home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / almanac.src < prev    next >
Text File  |  1991-02-21  |  6KB  |  353 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ by Tom Metcalf
  3. DIR
  4.   SOLVE
  5.     \<< -22 SF 4 FIX
  6. DEG 0 0 0 0 0 GSUM
  7. a0 \->NUM 'A0' STO a1
  8. \->NUM 'A1' STO EV1
  9. \->NUM DUP '\Ga1' STO
  10. EIGEN 'E1' STO EV3
  11. \->NUM DUP '\Ga3' STO
  12. EIGEN 'E3' STO EV2
  13. \->NUM DUP '\Ga2' STO
  14. EIGEN 'E2' STO R E1
  15. DOT '\Gb1' STO R E2
  16. DOT '\Gb2' STO R E3
  17. DOT '\Gb3' STO 0
  18. 'NIT' STO 0 '\Gm' STO
  19.       DO \Gm 'OLD'
  20. STO ITER '\Gm' STO 1
  21. 'NIT' STO+
  22.       UNTIL 'ABS((\Gm
  23. -OLD)/\Gm)<.000001 OR
  24. NIT>50'
  25.       END
  26.       IF 'NIT>50 OR
  27. \Gm >\Ga1'
  28.       THEN
  29. "CONVERGENCE ERROR"
  30.       END UVW OBJ\->
  31. DROP OUT
  32.     \>>
  33.   ADDOB
  34.     \<< \-> T A
  35.       \<< T HMS\-> 'T'
  36. STO A HMS\-> 'A' STO
  37. OBS
  38.         IFERR OBJ\->
  39.         THEN T GHA1
  40. GHA2 INTERP T DEC1
  41. DEC2 INTERP A { 1 3
  42. } \->ARRY SWAP STO
  43.         ELSE OBJ\->
  44. ROT 1 + ROT ROT
  45. \->LIST T GHA1 GHA2
  46. INTERP SWAP T DEC1
  47. DEC2 INTERP SWAP A
  48. SWAP \->ARRY 'OBS'
  49. STO
  50.         END
  51.       \>>
  52.     \>>
  53.   CORRECT
  54.     \<< DEG HMS\-> INDX
  55. + HGT \v/ .0293 * -
  56. DUP DUP DUP 4.4 +
  57. 7.31 SWAP / + TAN
  58. .0167 SWAP / SWAP
  59. COS
  60.       CASE BODY 'S'
  61. SAME
  62.         THEN .0024
  63. * SEMI
  64.         END BODY
  65. 'M' SAME
  66.         THEN HP *
  67. HP .2724 *
  68.         END BODY
  69. 'VM' SAME
  70.         THEN HP * 0
  71.         END 0 * 0
  72.       END LU * +
  73. SWAP - +
  74.       IF 'SPD>0'
  75.       THEN SWAP
  76. HMS\-> DUP DUP GHA1
  77. GHA2 INTERP SWAP
  78. DEC1 DEC2 INTERP
  79. SWAP DRLAT DRLON
  80. AZIM DUP CSCORR ROT
  81. SWAP - SWAP \->HMS
  82. SWAP
  83.       END \->HMS
  84.     \>>
  85.   SETUP
  86.     \<< "BODY?" { ""
  87. \Ga V } INPUT OBJ\->
  88. 'BODY' STO
  89. "INDEX? (Deg)" { ""
  90. V } INPUT OBJ\-> HMS\->
  91. 'INDX' STO
  92.       IF BODY 'S'
  93. SAME
  94.       THEN
  95. "SEMI-D? (Deg)" {
  96. "" V } INPUT OBJ\->
  97. HMS\-> 'SEMI' STO
  98.       END
  99.       IF BODY 'M'
  100. SAME BODY 'VM' SAME
  101. OR
  102.       THEN
  103. "HP? (Deg)" { "" V
  104. } INPUT OBJ\-> HMS\->
  105. 'HP' STO
  106.       END
  107.       IF BODY 'M'
  108. SAME BODY 'S' SAME
  109. OR
  110.       THEN
  111. "LIMB (L/U/C=1/-1/0)?"
  112. { "" V } INPUT OBJ\->
  113. 'LU' STO
  114.       END
  115. "HEIGHT (m)?" { ""
  116. V } INPUT OBJ\->
  117. 'HGT' STO
  118. "GHA1 DEC1 TIM1?" {
  119. ":GHA1:
  120. :DEC1:
  121. :TIM1:"
  122. { 1 0 } V } INPUT
  123. OBJ\-> HMS\-> 'T1' STO
  124. HMS\-> 'DEC1' STO
  125. HMS\-> 'GHA1' STO
  126. "GHA2 DEC2 TIM2" {
  127. ":GHA2:
  128. :DEC2:
  129. :TIM2:"
  130. { 1 0 } V } INPUT
  131. OBJ\-> HMS\-> 'T2' STO
  132. HMS\-> 'DEC2' STO
  133. HMS\-> 'GHA2' STO
  134. "SPEED? (Knots)" {
  135. "" V } INPUT OBJ\->
  136. 'SPD' STO
  137.       IF 'SPD\=/0'
  138.       THEN
  139. "COURSE? (True)" {
  140. "" V } INPUT OBJ\->
  141. HMS\-> 'CRS' STO
  142. "DR LAT LON?" {
  143. ":LAT:
  144. :LON:" { 1 0
  145. } V } INPUT OBJ\->
  146. HMS\-> 'DRLON' STO
  147. HMS\-> 'DRLAT' STO
  148. "TIME OF FIX?" { ""
  149. V } INPUT OBJ\-> HMS\->
  150. 'TF' STO
  151.       ELSE 0 'CRS'
  152. STO 0 'DRLAT' STO 0
  153. 'DRLON' STO 0 'TF'
  154. STO
  155.       END
  156.     \>>
  157.   ERROR
  158.     \<< 0 0 0 0 0 0 0
  159. 0 \-> H1 H2 D1 D2 G1
  160. G2 DT DH
  161.       \<< OBS { 1 3 }
  162. GET 'H1' STO OBS {
  163. N 3 } GET 'H2' STO
  164. OBS { 1 2 } GET
  165. 'D1' STO OBS { N 2
  166. } GET 'D2' STO OBS
  167. { 1 1 } GET 'G1'
  168. STO OBS { N 1 } GET
  169. 'G2' STO T2 T1 -
  170. GHA2 GHA1 - / G2 G1
  171. - * 'DT' STO H2 H1
  172. - 'DH' STO 1 DT / N
  173. \v/ / 57.3 H1 H2 + 2
  174. / COS * * 225 D1 D2
  175. + 2 / COS SQ * DH
  176. DT / SQ - \v/ / "ERR"
  177. \->TAG
  178.       \>>
  179.     \>>
  180.   NIT 4
  181.   ITER
  182.     \<< 0 0 \-> f fp
  183.       \<< \Gb1 \Ga1 \Gm - /
  184. SQ DUP 'f' STO+ 2 *
  185. \Ga1 \Gm - / 'fp' STO+
  186. \Gb2 \Ga2 \Gm - / SQ DUP
  187. 'f' STO+ 2 * \Ga2 \Gm -
  188. / 'fp' STO+ \Gb3 \Ga3 \Gm
  189. - / SQ DUP 'f' STO+
  190. 2 * \Ga3 \Gm - / 'fp'
  191. STO+ -1 'f' STO+ \Gm
  192. f fp / -
  193.       \>>
  194.     \>>
  195.   a0 '-(G12*G23-G13
  196. *G22)*G13+(G11*G23-
  197. G12*G13)*G23-(G11*
  198. G22-G12^2)*G33'
  199.   a1 'G11*G22-G12^2
  200. +G11*G33-G13^2+G22*
  201. G33-G23^2'
  202.   TF 0
  203.   DRLON 0
  204.   DRLAT 0
  205.   CRS 0
  206.   SPD 0
  207.   CSCORR
  208.     \<< \-> T
  209.       \<< SPD T TF -
  210. AZ CRS - COS 60 / *
  211. *
  212.       \>>
  213.     \>>
  214.   AZ 239.148905272
  215.   AZIM
  216.     \<< \-> D G L A
  217.       \<< G A - 'A'
  218. STO L COS D SIN * L
  219. SIN D COS A COS * *
  220. - A SIN D COS NEG *
  221. R\->C ARG 'AZ' STO
  222.         IF 'AZ<0'
  223.         THEN 360
  224. 'AZ' STO+
  225.         END
  226.       \>>
  227.     \>>
  228.   EV3 '-2*\v/Q*COS((\Gh
  229. +360)/3)+N/3'
  230.   EV2 'N-\Ga1-\Ga3'
  231.   EV1 '-2*\v/Q*COS(\Gh/
  232. 3)+N/3'
  233.   OLD
  234. -1.47280528459E-7
  235.   \Gm
  236. -1.47296963855E-7
  237.   \Gb3 -13.5624809912
  238.   \Gb2
  239. -1.50525051351E-2
  240.   \Gb1
  241. -3.950284015E-7
  242.   E3
  243. [ .188406852706 .980097318647 6.25468131232E-2 ]
  244.   E2
  245. [ -1.40179729991E-2 6.63646826456E-2 -.997696960669 ]
  246.   E1
  247. [ -.981991016574 .187096170084 2.62424562793E-2 ]
  248.   INTERP
  249.     \<< \-> T V1 V2
  250.       \<< V1 V2 V1 -
  251. T2 T1 - / T T1 - *
  252. +
  253.       \>>
  254.     \>>
  255.   GSUM
  256.     \<< \-> DS DC GS GC
  257. HS
  258.       \<< 0 'G11' STO
  259. 0 'G12' STO 0 'G13'
  260. STO 0 'G22' STO 0
  261. 'G23' STO { 3 } 0
  262. CON 'R' STO OBS
  263. OBJ\-> OBJ\-> DROP DROP
  264. 'N' STO 1 N
  265.         START SIN
  266. 'HS' STO DUP SIN
  267. 'DS' STO COS 'DC'
  268. STO DUP SIN 'GS'
  269. STO COS 'GC' STO DS
  270. SQ 'G11' STO+ DS DC
  271. GC * * 'G12' STO+
  272. DS DC GS * * 'G13'
  273. STO+ DC SQ GC SQ *
  274. 'G22' STO+ DC SQ GS
  275. GC * * 'G23' STO+ R
  276. OBJ\-> DROP DC GS HS
  277. * * + ROT DS HS * +
  278. ROT DC GC HS * * +
  279. ROT { 3 } \->ARRY 'R'
  280. STO
  281.         NEXT N G11
  282. G22 + - 'G33' STO
  283.       \>>
  284.     \>>
  285.   OUT
  286.     \<< \-> U V W
  287.       \<<
  288.         IF 'ABS(U)>
  289. 1'
  290.         THEN U SIGN
  291. 'U' STO
  292.         END U ASIN
  293. V W R\->C ARG \->HMS
  294. "LON" \->TAG SWAP
  295. \->HMS "LAT" \->TAG
  296.       \>>
  297.     \>>
  298.   UVW
  299.     \<< \Gb1 \Ga1 \Gm - /
  300. E1 * \Gb2 \Ga2 \Gm - / E2
  301. * \Gb3 \Ga3 \Gm - / E3 *
  302. + +
  303.     \>>
  304.   EIGEN
  305.     \<< \-> EV
  306.       \<< 'G12*G23-
  307. G13*G22+G13*EV'
  308. \->NUM 'G13*G12-G11*
  309. G23+G23*EV' \->NUM '
  310. G11*G22-SQ(G12)-(
  311. G11+G22)*EV+SQ(EV)'
  312. \->NUM { 3 } \->ARRY
  313. DUP ABS /
  314.       \>>
  315.     \>>
  316.   \Ga2 .0363326349
  317.   \Ga3 17.9636667352
  318.   \Ga1 .0000006299
  319.   \Gh 'ACOS(R1/Q^1.5)
  320. '
  321.   R1 'A0/2+N/3*(A1/
  322. 6-Q)'
  323.   Q '(N/3)^2-A1/3'
  324.   N 18
  325.   A0
  326. -4.110603687E-7
  327.   A1 .6526786832
  328.   G33 .1064412066
  329.   R
  330. [ -2.55505296373 -13.2935502826 -.833272135648 ]
  331.   G23 1.09880240075
  332.   G22 17.255892215
  333.   G13 .212196428198
  334.   G12 3.31708381131
  335.   G11 .637666578414
  336.   GHA2
  337. 92.6916666667
  338.   DEC2
  339. 16.4916666667
  340.   T2 18
  341.   GHA1 77.65
  342.   DEC1
  343. 16.4916666667
  344.   T1 17
  345.   LU 1
  346.   SEMI
  347. .266666666667
  348.   HP .986666666667
  349.   HGT 0
  350.   INDX 0
  351.   BODY T
  352. END
  353.